EPA calculation, WP is done later following a similar process
Test Plot to visualize field and understand which metrics represent length and width
test_plot<- ggplot() +
geom_point(data = iona_game_res, aes(x = as.numeric(X), y = as.numeric(Y), color = simplex_play_type))
test_plot
EPA by field position
Team <- c('Notre Dame','Syracuse','Iona','St. Bonaventure','Michigan','Kutztown')
colors1 <- c('#0C2340','#D44500','#6F2C3F','#54261A','#00274C','#77253A')
colors2 <- c('#AE9142','#3E3D3C','#F2A900','#FDB726','#FFDB05','#7E6F42')
crests <- c('https://upload.wikimedia.org/wikipedia/en/7/71/NDRFC_crest.png',
'https://www.urugby.com/sites/default/files/styles/front-normal-sponsor_300wide/public/syracuse-university.png?itok=_Y6MmfN0',
'https://icgaels.com/images/logos/site/site.png', #No crest
'https://s3-us-west-2.amazonaws.com/theathletic-team-logos/team-logo-326-300x300.png', #Their new logo isn't a png even though it's sooooo much better
'https://lirp-cdn.multiscreensite.com/5fcdb223/dms3rep/multi/opt/rugby-crest-640w.jpg', #No PNG
'https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcSD0FxVZT0agtaXu72F9zLpnkJHKbjuozHFLA&usqp=CAU')
TX <- c(1,2,3,4,5,6)
TY <- c(1,2,3,4,5,6)
logos_df <- data.frame(Team,colors1,colors2,crests,TX,TY)
#for later
ND_blue <- logos_df$colors1[1]
Syracuse_orange <- logos_df$colors1[2]
Iona_red <- logos_df$colors[3]
stbonaventure_brown <- logos_df$colors1[4]
michigan_maize <- logos_df$colors2[5]
kutztown_red <- logos_df$colors1[6]
Logo viz for use later
EPA by field posiition (X represents length)
g_3 <- ggplot(iona_game_res,
aes(x = X, color = simplex_play_type)) +
geom_point(aes(y = EPA), size = 2) +
theme_bw()
g_3
EPA by time
g_4 <- ggplot(iona_game_res,
aes(x = TimeEnd, color = simplex_play_type)) +
geom_point(aes(y = EPA), size = 2) +
theme_bw()
g_4
EPA by playtype and field position
g_10 <- ggplot(iona_game_res)+
geom_point(aes(x = X, y=EPA, color = Team),size =2)+
theme_bw()+
facet_wrap(facets = vars(simplex_play_type))
g_10
Penalty kick chart
penalty_plot <- ggplot() +
ggtitle("Penalty Conversions in Notre Dame Matches") +
annotate("text", x = c(150,530),
y = c(600,600), label = "10", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(530,150),
y = c(780,780), label = "22", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530),
y = c(1000,1000), label = "G", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530),
y = c(500,500), label = "50", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("segment", x = 0,
y = c(600,780,1000,500),
xend = 680,
yend = c(600,780,1000,500), color = "black") +
geom_point(data = penalty_res, aes(x = xmax-as.numeric(Y), y = as.numeric(X), shape = PlayType, color = PlayType, size = 5), alpha = 0.7) +
scale_shape_manual(values = c(17,16)) +
scale_colour_manual(values=c("black","red")) +
theme(panel.background = element_rect(fill = 'light green', colour = 'black')) +
ylim(500, ymax) +
coord_fixed() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
labs(x = "MidField", y = "Sideline") # Set labels
penalty_plot
Overall kicking chart
kicking_res <- ggplot() +
ggtitle("Opponents vs ND Kicking") +
annotate("text", x = c(150,530),
y = c(600,600), label = "10", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(530,150),
y = c(780,780), label = "22", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530),
y = c(1000,1000), label = "G", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530),
y = c(500,500), label = "50", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("segment", x = 0,
y = c(600,780,1000,500),
xend = 680,
yend = c(600,780,1000,500), color = "black") +
geom_point(data = kicking_res, aes(x = xmax-as.numeric(Y), y = as.numeric(X), shape = PlayType, color = PlayType, size = 5), alpha = 0.5) +
scale_shape_manual(values = c(17,16,15,16)) +
scale_colour_manual(values=c("black","red","blue","pink")) +
theme(panel.background = element_rect(fill = 'light green', colour = 'black')) +
ylim(500, ymax) +
facet_wrap(facets = vars(ND_Possession))+
coord_fixed() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
labs(x = "MidField", y = "Sideline") # Set labels
#Go into zoom to see this onen well
kicking_res
Geospatial tracking plot, not great now but the goal is to have a frame up for when better tracking data is available
g_9track <- ggplot() +
scale_size_manual(values = c(6, 6), guide = FALSE) +
scale_shape_manual(values = c(21, 21), guide = FALSE) +
scale_fill_manual(values = c("#6F2C3F", "#0c2340"), guide = FALSE) +
scale_colour_manual(values = c("#F2A900", "#d39F10"), guide = FALSE) +
annotate("text", x = c(150,530,150,530),
y = c(400,600,600,400), label = "10", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530,150,530),
y = c(220,220,780,780), label = "22", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530,150,530),
y = c(0,0,1000,1000), label = "G", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530),
y = c(500,500), label = "50", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("segment", x = 0,
y = c(400,600,220,780,0,1000,500),
xend = 680,
yend = c(400,600,220,780,0,1000,500), color = "black") +
geom_point(data = iona_game_res, aes(x = xmax-as.numeric(Y), y = as.numeric(X), shape = Team, fill = Team, size = Team,
color = Team), alpha = 0.7) +
# labs(title = "ND: {iona_game_res$NDScore}") +
transition_time(iona_game_res$TimeBegin)+
theme(panel.background = element_rect(fill = 'light green', colour = 'black')) +
ylim(ymin, ymax) +
coord_fixed() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
labs(x = "TryLine", y = "Sideline") # Set labels
# title = paste("ND v Iona Timelaps - {iona_game_res$NDScore}",)
g_9track
Series of win probability plots, all follow this framework
cuse_wp <- ggplot(syracuse_game_res) +
geom_smooth(aes(x = game_seconds_remaining,y = NDwp), size = 2, color = ND_blue) +
geom_smooth(aes(x = game_seconds_remaining,y = Oppwp), size = 2, color = Syracuse_orange) +
geom_vline(xintercept = 5000, linetype = 'dashed', color = 'black') +
# annotate("text", size = 8, x = 5000, y = 1, label = "Gaels", color = '#6F2C3F') +
# annotate("text", size = 8, x = 3000, y = .25, label = "Fighting Irish", color = '#0C2340') +
# transition_time(game_seconds_remaining)+ #I want to explore transition time here
labs( x = "Time Passed (seconds)",
y = "Win Probability",
title = "Notre Dame v Syracuse",
subtitle = "In Syracuse, NY") +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
theme_bw()
cuse_wp
The thought is that with more games uploaded in the future, these will become more accurate
EPA Grid
grid_g <- ggplot(data = grid_vals) +
annotate("text", x = c(150,530,150,530),
y = c(400,600,600,400), label = "10", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530,150,530),
y = c(220,220,780,780), label = "22", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530,150,530),
y = c(0,0,1000,1000), label = "G", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("text", x = c(150,530),
y = c(500,500), label = "50", hjust = 0, vjust = -0.2,angle =90, color = "black") +
annotate("segment", x = 0,
y = c(400,600,220,780,0,1000,500),
xend = 680,
yend = c(400,600,220,780,0,1000,500), color = "black") +
theme(panel.background = element_rect(fill = 'light green', colour = 'black')) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
geom_rect(aes(xmin = xmin, # Set minimum x value
xmax = xmax , # Set maximum x value
ymin = ymin, # Set minimum y value
ymax = ymax, # Set maximum y value
fill = avgEPA), # Set fill of each rectangle
alpha = 0.9) + # Set transperancy
scale_fill_gradient(low = "blue", high = "red") # Scale fill gradient
grid_g
EPA grid by position group
ggarrange(grid_g,grid_forward,grid_back,
labels = c("Total","Forwards","Backs"),
ncol = 3, nrow = 1,heights = c(1,1,1), widths = c(2,2,2))